perm filename MKFONT[1,BGB] blob
sn#023246 filedate 1973-02-23 generic text, type T, neo UTF8
00100 TITLE MKFONT - MAKE FONT - BGB - 2 FEBRUARY 1973.
00200
00300 INTERN MKFONT,ENDPTR
00400
00500 ;VARIABLES GLOBAL TO THE SUBROUTINES OF THIS FILE.
00600
00700 EXTERN RMIN,RMAX,CMIN,CMAX,FILM
00800 DECLARE{CMAX2}
00900 DECLARE{ROWCNT,COLCNT,WRDWID,GSIZE}
01000 DECLARE{GPTR,ORGPTR,ENDPTR} ;FONT SEGMENT.
01100 DECLARE{ORGROW,ORGCOL,ENDROW,ENDCOL} ;GLYPH POSITIONING.
01200
01300 $←400000
01400 O(CORE2,CALLI 400015)
00100 SUBR(MKFONT)------------------------------------------------------
00200 BEGIN MKFONT; MAKE FONT - BGB - 2 FEBRUARY 1973.
00300 EXTERN CTRL,META
00350 LAC CTRL↔AND META↔JUMPN L0 ;CONTINUE FONT.
00400 SETZM HFLAG#↔SKIPE CTRL↔SETOM HFLAG
00500
00600 ;CREATE FONT SEGMENT.
00700 SETZ↔CORE2↔HALT
00800 LACI $+1777↔DAC ENDPTR
00900 CORE2↔HALT ;MAKE UPPER SEG.
01000 SETZM $↔LAC[XWD $,$+1]↔BLT $+1777 ;CLEAR FONT SPACE.
01100 LAC[SIXBIT/FONT/]↔CALLI $+36↔JFCL ;NAME UPPER SEG.
01200 LACI $+200↔DAC ORGPTR
01300 L0: SETZM CTRL↔SETZM META
01350 LAC 1,FILM↔SON 1,1↔SKIPN 1↔POP0J ;IMAGE.
01400 DAC 1,IMAGE0↔DAC 1,IMAGE1↔GO L2
01500
01600 ;CREATE A GLYPH FOREACH IMAGE OF THE FILM.
01700 L1: EXTERN NEXIMG↔CALL(NEXIMG)
01800 LAC 1,FILM↔SON 1,1↔DAC 1,IMAGE1
01900 CAMN 1,IMAGE0↔GO L3
02000 L2: EXTERN REGION↔CALL(REGION)
02100 SKIPN HFLAG↔GO[
02200 CALL(MKGLY1,IMAGE1)↔CALL(DAG1)↔GO L1] ;ONE INTO ONE.
02300 CALL(MKGLY2,IMAGE1)↔CALL(DAG2)↔GO L1 ;FOUR INTO ONE.
02400
02500 L3: SETZM RMIN↔SETZM RMAX
02525 EXTERN DPYPAK↔CALL(DPYPAK)
02550 OUTSTR[ASCIZ/ END OF MAKE FONT.
02600 /]↔ POP0J
02700
02800 DECLARE{IMAGE0,IMAGE1}
02900
03000 BEND;2/2/73-------------------------------------------------------
00100 SUBR(MKGLY1)IMAGE-------------------------------------------------
00200 BEGIN MKGLY1;ALLOCATE GLYPH SPACE AND DIMENSIONS.
00300
00400 ACCUMULATORS{A,B,LVL}
00500 LAC 1,ARG1
00600 SON LVL,1
00700 NCNT A,LVL ;ASCII CODE.
00750 CAIGE A,200↔SKIPG A
00800 GO[OUTSTR[ASCIZ/ CHARACTER = /]
00900 INCHRW A↔NCNT. A,LVL↔CRLF↔GO .+1]
01000
01100 ;PLACE GLYPH POINTER INTO ASCII TABLE.
01200
01300 LAC B,ORGPTR
01400 TRZ B,$
01500 DAC B,$(A)
01600
01700 ;COMPUTE GLYPH DIMENSIONS.
01800
01900 LAC RMAX↔SUB RMIN↔AOS↔DAC ROWCNT
02000 LAC CMAX↔SUB CMIN↔AOS↔DAC COLCNT
02100 IDIVI =36↔SKIPE 1↔AOS↔DAC WRDWID
02200 LAC WRDWID↔IMUL ROWCNT↔ADDI 3↔DAC GSIZE
02300
02400 LAC WRDWID↔IMULI =36↔ADD CMIN↔SOS↔DAC CMAX2
02500
02600 ;COMPUTE GLYPH POSITION.
02700
02800 LAC ROWCNT↔DAC ENDROW
02900 LAC ROWCNT↔DACN ORGROW
03000 SETZM ORGCOL
03100 LAC COLCNT↔ADDI 5↔DAC ENDCOL
03200
03300 ;UPDATE ORG POINTER AND EXPAND FONT SPACE WHEN NECESSARY.
03400
03500 LAC ORGPTR↔DAC GPTR
03600 ADD GSIZE↔DAC ORGPTR
03700 CAMG ENDPTR↔POP1J
03800 LAC ENDPTR↔ADDI 2000↔DAC ENDPTR
03900 CORE2↔GO[
04000 FATAL({FONT SPACE EXHAUTED.})]
04100 LAC ENDPTR↔SUBI 1777↔SETZM@↔DIP↔AOS
04200 LAC 1,ENDPTR↔BLT(1)↔POP1J
04300
04400 BEND;2/2/73-------------------------------------------------------
00100 SUBR(DAG1)--------------------------------------------------------
00200 BEGIN DAG1;DEPOSIT GLYPH INTO FONT - 1 FOR 1 - BGB - 2 FEB 1973.
00300 EXTERN PAKPTR
00400 ACCUMULATORS{R,C,G,PTR,GLY}
00500 LAC G,GPTR ;GLYPH POINTER.
00600 ;HEADER.
00700 LAC ROWCNT↔DIP 0(G) ;ROW COUNT.
00800 LAC WRDWID↔DAP 0(G) ;WORD WIDTH.
00900 LAC ORGROW↔DIP 1(G) ;ORIGIN VECTOR.
01000 LAC ORGCOL↔DAP 1(G)
01100 LAC ENDROW↔DIP 2(G) ;END VECTOR.
01200 LAC ENDCOL↔DAP 2(G)
01300
01400 ;MOVE BIT ARRAY INTO GLYPH.
01500
01600 LAC GLY,[POINT 1,0,-1]
01700 ADDI GLY,3(G)
01800 LAC R,RMIN
01900 L1: LAC C,CMIN↔LSH R,3
02000 L2: LDB PAKPTR(C) ;DOUBLE INDEXED BY (R).
02100 IDPB GLY
02200 AOS C
02300 CAMG C,CMAX2↔GO L2
02400 LSH R,-3↔AOS R
02500 CAMG R,RMAX↔GO L1
02700 POP0J
02800 BEND;2/2/73-------------------------------------------------------
00100 SUBR(MKGLY2)IMAGE-------------------------------------------------
00200 BEGIN MKGLY2;ALLOCATE GLYPH SPACE AND DIMENSIONS.
00300
00400 ACCUMULATORS{A,B,LVL}
00500 LAC 1,ARG1
00600 SON LVL,1
00700 NCNT A,LVL ;ASCII CODE.
00800 CAIGE A,200↔SKIPG A
00900 GO[OUTSTR[ASCIZ/ CHARACTER = /]
01000 INCHRW A↔NCNT. A,LVL↔CRLF↔GO .+1]
01100
01200 ;PLACE GLYPH POINTER INTO ASCII TABLE.
01300
01400 LAC B,ORGPTR
01500 TRZ B,$
01600 DAC B,$(A)
01700
01800 ;COMPUTE GLYPH DIMENSIONS.
01900
02000 LAC RMAX↔SUB RMIN↔AOS
02050 TRNE 1↔AOS↔ASH -1↔DAC ROWCNT
02100 LAC CMAX↔SUB CMIN↔AOS
02125 TRNE 1↔AOS↔ASH -1↔DAC COLCNT
02150
02200 IDIVI =36↔SKIPE 1↔AOS↔DAC WRDWID
02300 LAC WRDWID↔IMUL ROWCNT↔ADDI 3↔DAC GSIZE
02400
02500 LAC WRDWID↔IMULI =72↔ADD CMIN↔SOS↔DAC CMAX2
02600
02700 ;COMPUTE GLYPH POSITION.
02800
02900 LAC ROWCNT↔DAC ENDROW
03000 LAC ROWCNT↔DACN ORGROW
03100 SETZM ORGCOL
03200 LAC COLCNT↔ADDI 5↔DAC ENDCOL
03300
03400 ;UPDATE ORG POINTER AND EXPAND FONT SPACE WHEN NECESSARY.
03500
03600 LAC ORGPTR↔DAC GPTR
03700 ADD GSIZE↔DAC ORGPTR
03800 CAMG ENDPTR↔POP1J
03900 LAC ENDPTR↔ADDI 2000↔DAC ENDPTR
04000 CORE2↔GO[
04100 FATAL({FONT SPACE EXHAUTED.})]
04200 LAC ENDPTR↔SUBI 1777↔SETZM@↔DIP↔AOS
04300 LAC 1,ENDPTR↔BLT(1)↔POP1J
04400
04500 BEND;2/2/73-------------------------------------------------------
00100 SUBR(DAG2)--------------------------------------------------------
00200 BEGIN DAG2;DEPOSIT GLYPH INTO FONT - 4 INTO 1 - BGB - 2 FEB 1973.
00300 EXTERN PAKPTR
00400 ACCUMULATORS{R,C,G,PTR,GLY,CNT}
00500 LAC G,GPTR ;GLYPH POINTER.
00600 ;HEADER.
00700 LAC ROWCNT↔DIP 0(G) ;ROW COUNT.
00800 LAC WRDWID↔DAP 0(G) ;WORD WIDTH.
00900 LAC ORGROW↔DIP 1(G) ;ORIGIN VECTOR.
01000 LAC ORGCOL↔DAP 1(G)
01100 LAC ENDROW↔DIP 2(G) ;END VECTOR.
01200 LAC ENDCOL↔DAP 2(G)
01300
01400 ;MOVE BIT ARRAY INTO GLYPH - FOUR TO ONE.
01500
01600 LAC GLY,[POINT 1,0,-1]
01700 ADDI GLY,3(G)
01800 LAC R,RMIN
01900 L1: LAC C,CMIN↔LSH R,3
02000 L2: SETZ CNT,
02100 LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C
02200 LDB PAKPTR(C)↔SKIPE↔AOS CNT↔SOS C↔ADDI R,8
02300 LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C
02400 LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C↔SUBI R,8
02600 SETZ↔CAILE CNT,1↔SETO↔IDPB GLY
02800 CAMG C,CMAX2↔GO L2
02900 LSH R,-3↔AOS R↔AOS R
03000 CAMG R,RMAX↔GO L1
03100 POP0J
03200 BEND;2/2/73-------------------------------------------------------
00100 END